unit CRMClasses;

interface

uses Classes, SysUtils, Controls, CommCtrl, Forms, ShellApi, Windows, Dialogs;

type
  TObjectCounter = class
  private
    FItems: TStringList;
    procedure Check;
  public
    procedure IncCount(AClassName: string);
    procedure DecCount(AClassName: string);
    constructor Create;
    destructor Destroy; override;
  end;

  IWaitObject = interface
  end;

  TWaitObject = class(TInterfacedObject, IWaitObject)
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TIntVector = array of integer;

  TVectorUtils = class
  public
    class function PosValInVector(val: integer; vec: TIntVector): integer;
    class procedure AddToVector(Val: integer; var Vec: TIntVector);
    class function VectorToStr(Vec: TIntVector; Delim: string): string;
    class function VectorToLogic(Vec: TIntVector; Field, Logic: string): string;
  end;

procedure ExecAndWait(FileName: string; Params: string; App: TApplication);

const
  P1 = 'gfhj';
  P2 = 'km,f';

var
  ObjCounter: TObjectCounter;
  
implementation

{ TObjectCounter }

procedure ExecAndWait(FileName: string; Params: string; App:TApplication);
var
  exInfo: TShellExecuteInfo;
  Ph: Longword;
begin
  FillChar(exInfo, SizeOf(exInfo), 0);
  with exInfo do
  begin
    cbSize := SizeOf(exInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := GetActiveWindow();
    ExInfo.lpVerb := 'open';
    ExInfo.lpParameters := PChar(Params);
    lpFile := PChar(FileName);
    nShow := SW_HIDE;
  end;
  if ShellExecuteEx(@exInfo) then
    Ph := exInfo.HProcess
  else
  begin
    ShowMessage(SysErrorMessage(GetLastError));
    Exit;
  end;
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
    App.ProcessMessages;
  CloseHandle(Ph);
end;

procedure TObjectCounter.Check;
var
  i: integer;
  res: TStringList;
begin
  res := TStringList.Create;
  try
    for i := 0 to FItems.Count - 1 do
      if StrToInt(FItems.ValueFromIndex[i]) <> 0 then
        res.Add(FItems[i]);
    Assert(res.Count = 0, 'TObjectCounter:'#13 + res.Text);
  finally
    res.Free;
  end;

end;

constructor TObjectCounter.Create;
begin
  FItems := TStringList.Create;
  FItems.Delimiter := '|';
end;

procedure TObjectCounter.DecCount(AClassName: string);
var
  idx, cnt: integer;
begin
  idx := FItems.IndexOfName(AClassName);
  Assert(idx <> -1, 'TObjectCounter - 1 (' + AClassName + ')');

  cnt := StrToInt(FItems.ValueFromIndex[idx]);
  dec(cnt);
  FItems.ValueFromIndex[idx] := IntToStr(cnt);
end;

destructor TObjectCounter.Destroy;
begin
  Check;
  FItems.Free;
  inherited;
end;

procedure TObjectCounter.IncCount(AClassName: string);
var
  idx, cnt: integer;
begin
  idx := FItems.IndexOfName(AClassName);
  if idx = -1 then
    FItems.Add(AClassName + '=1')
  else
    begin
      cnt := StrToInt(FItems.ValueFromIndex[idx]);
      inc(cnt);
      FItems.ValueFromIndex[idx] := IntToStr(cnt);
    end;
end;

{ TWaitObject }

constructor TWaitObject.Create;
begin
  Screen.Cursor:=crHourglass;
end;

destructor TWaitObject.Destroy;
begin
  Screen.Cursor := crDefault;
  inherited;
end;

{ TVectorUtils }

class procedure TVectorUtils.AddToVector(Val: integer;
  var Vec: TIntVector);
var
  len: integer;
begin
  len := Length(Vec);
  SetLength(Vec, len + 1);
  Vec[len] := Val;
end;

class function TVectorUtils.PosValInVector(val: integer;
  vec: TIntVector): integer;
var
  i: integer;
begin
  Result := -1;
  if Length(vec) = 0 then
    Exit;
  for i := 0 to Length(vec) - 1 do
    if vec[i] = val then
    begin
      Result := i;
      Break;
    end;
end;

class function TVectorUtils.VectorToLogic(Vec: TIntVector; Field,
  Logic: string): string;
var
  i: integer;
begin
  Result := '';

  for i := 0 to Length(Vec) - 1 do
  begin
    if i <> 0 then
      Result := Result + Format(' %s ', [Logic]);
    Result := Result + Format('(%s = %d)', [Field, Vec[i]]);
  end;
end;

class function TVectorUtils.VectorToStr(Vec: TIntVector;
  Delim: string): string;
var
  i, len: integer;
begin
  len := Length(Vec) - 1;
  for i := 0 to len do
  begin
    Result := Result + IntToStr(Vec[i]);
    if len <> i then
      Result := Result + Delim;
  end;
end;

end.
